home *** CD-ROM | disk | FTP | other *** search
/ Shareware Extravaganza - Disc 4 / Shareware Extravaganza - Over 25,000 Programs (The Ultimate Shareware Company)(Disc 4 of 4)(1993).iso / cad / arcldr2.zip / ARCLDR2.LSP
Lisp/Scheme  |  1990-01-14  |  7KB  |  194 lines
  1. ;===========================================================
  2. ;               ARCLDR.LSP
  3. ;(C) 1987 by Looking Glass Microproducts
  4. ;
  5. ;  Arc Leader draws single- and multiple-arc leaders with
  6. ;  curved arrowheads and dynamic text.  If you have AutoCAD
  7. ;  2.6 or higher, Arcldr uses the DimSCALE DimASZ, and
  8. ;  DimTXT variables to determine its arrow and text sizes.
  9. ;  If you have an earlier version of AutoCAD, a size of
  10. ;  0.18*LTScale is used.  Arcldr requires that the corrent
  11. ;  text style does not have a fixed height associated with
  12. ;  it.
  13. ;  ----------------HOW TO USE ARCLDR.LSP--------------------
  14. ;  Arcldr will prompt you for a start point at the text end
  15. ;  of the leader, a direction from the start point and an
  16. ;  endpoint for the arc segment.  If you are using Release 9
  17. ;  or higher, you will be dragging the endpoint of the arc.
  18. ;  You will then be prompted for an offset distance.  This
  19. ;  is how far you wish to S-curve while creating a
  20. ;  multiple-arc leader.  A <RETURN> entered at this point
  21. ;  completes the leader line, but if you enter (or point to)
  22. ;  an offset distance, an S-curve will be drawn to this point
  23. ;  from the end of the first arc.  The S-curve consists of
  24. ;  two arcs joined by a straight line segment. Then you will
  25. ;  be prompted for a second arc and the process repeats.
  26. ;  If you press <RETURN>, you finish drawing the arc segments
  27. ;  Arcldr will draw a curved arrowhead and drop into the Dtext
  28. ;  command, allowing you to provide multi-line leader text.
  29. ;  The text is automatically placed appropiattely to left or
  30. ;  right of the start point, opposite the first arc of the
  31. ; finished leader.
  32. ;-----------------------------------------------------------
  33. ; Input and debugged by William S. Brock from CADalyst
  34. ; magazine Vol. 5 No. 3  April 1988
  35. ;===========================================================
  36.  
  37. ;--------------------------------------- ERROR HALT
  38. (defun *error* (s)(princ (strcat "\n" s))
  39. (setvar "blipmode" bm)
  40. (princ))
  41. ;--------------------------------------- SAME POINT
  42. (defun samepoint (p0 p1)(<= (distance p0 p1) 1.0E-6))
  43.  
  44. ;----------------------------------------- DELTA XY
  45. (defun dxy (p0 dx dy)
  46. (list (+ (car p0) dx)(+ (cadr p0) dy)))
  47. ;--- QUADRANT OF STARTING ANGLE
  48. (defun quadrant (a)
  49. (fix (/ a (* 0.5 pi))))
  50.  
  51. ;---------------------------------------------- TAN
  52. (defun tan (a)
  53. (/ (sin a) (cos a)))
  54. ;--- MAIN BODY
  55. (defun c:arcldr ( / bm version twopi halfpi asiz tsiz
  56. p0 p1 ename ent cen rad sa ea eam sp ep ccw len tp fp0
  57. fp1 start lastp1 pastfp1 fr fd ho fe fc fc2 left om
  58. langle langle0)
  59. (graphscr)
  60.  
  61. ;----------------------------- LINE ANGLES FOR BENDS
  62. (setq
  63.    bangle  (/ (* 65.0 PI) 180.0)
  64.    bm      (getvar "blipmode")
  65.    om      (getvar "orthomode")
  66. ;----------------------------------AUTOLSIP VERSION
  67.    version (atof (substr (ver) 18))
  68.    twopi   (* 2.0 pi)
  69.    halfpi  (* 0.5 pi)
  70.    lastp1  nil
  71. ;-------------------------------------- ARROW SIZE
  72.    asiz (if (>= version 2.6)
  73.            (* (getvar "dimscale")(getvar "dimasz"))
  74.            (* (getvar "ltscale") 0.18)
  75.         );..... End if
  76.  
  77. ;--------------------------------------- TEXT SIZE
  78.    tsiz (if (>= version 2.6)
  79.            (* (getvar "dimscale")(getvar "dimtxt"))
  80.            (* (getvar "ltscale") 0.18)
  81.         );..... End if
  82. );...........End setq
  83. (setvar "cmdecho" 0)
  84. (setvar "blipmode" bm)
  85. ;--------------------------- START POINT OF LEADER
  86. (setq start (getpoint "\nFrom point: "))
  87. ;---------------------- CONTINUE IF POINT SELECTED
  88. (if start
  89.    (progn
  90.       (setq p0 start)
  91.       (setvar "orthomode" 1);----------------- ORTHO ON
  92.       (while (null (setq langle (getangle p0 "\nDirection: "))
  93.              )
  94.       )
  95.       (setq langle
  96.          (if (<= halfpi langle (* 1.5 pi))
  97.               pi 0.0) langle0 langle)))
  98. ;---------------------------------------------MAIN LOOP
  99. (while p0
  100.    (setvar "blipmode" bm)
  101.    (setvar "orthomode" 0)
  102.    (cond
  103.       ( ( >= version 9.0)
  104.          (command "pline" p0 "width" 0 0 "arc"
  105.                   "direction" (angtos langle) )
  106. (prompt "\nTo point: ")
  107. (command pause "";----------------------- GET END POINT
  108.         "explode" "l"))
  109. (T (while (not (setq p1
  110.    (getpoint "\nTo point: " p0))))
  111.    (command "arc" p0 "e" p1 "d" (angtos langle))))
  112. (setvar "blipmode" 0);--------------- SETS BLIPMODE OFF
  113.  
  114. ;--------------------------------------- DISECT THE ARC
  115. (setq
  116.  ename   (entlast)
  117.  ent     (entget ename)
  118.  cen     (cdr (assoc 10 ent))
  119.  rad     (cdr (assoc 40 ent))
  120.  sa      (cdr (assoc 50 ent))
  121.  ea      (cdr (assoc 51 ent))
  122.  eam     (if (< ea sa)(+ ea twopi) ea)
  123.  sp      (polar cen sa rad)
  124.  ep      (polar cen ea rad)
  125.  ccw     (samepoint sp p0)
  126.  len     (* rad (abs (- eam sa)))
  127.  );..................................End setq
  128. (if ccw
  129.   (setq tp (polar cen (- ea (/ asiz rad)) rad)
  130.         p1 ep a1 ea)
  131.   (setq tp (polar cen (+ sa (/ asiz rad)) rad)
  132.         p1 sp a1 sa)
  133. );......END IF
  134.  
  135. ;---------------------------------- ADD ANOTHER SEGMENT
  136. (SETVAR "ORTHOMODE" 1)
  137. (SETVAR "BLIPMODE" BM)
  138. (setq p0 nil
  139.       ho (getdist p1"\nOffset distance: "))
  140. (setvar "orthomode" 0)
  141. (setvar "blipmode" 0)
  142. (if ho
  143.   (progn
  144.      (setq  quad (quadrant a1)
  145.             fr   (/ ho (+ 1.0 (abs (sin a1))
  146.                         (/ 2.0 (cos bangle))))
  147.             ls   (* 2.0 fr (tan bangle))
  148.             fc   (polar p1 a1 fr))
  149.    (cond ((= quad 0) (setq
  150.             fe   (polar fc (- halfpi bangle) fr)
  151.            fc2  (polar fc halfpi (* fr (/ 2.0 (cos bangle))))))
  152.          ((= quad 1) (setq
  153.             fe   (polar fc (+ bangle halfpi) fr)
  154.            fc2  (polar fc halfpi (* fr (/ 2.0 (cos bangle))))))
  155.  
  156.          ((= quad 2) (setq
  157.             fe   (polar fc (-(+ halfpi bangle)) fr)
  158.            fc2  (polar fc (- halfpi) (* fr (/ 2.0 (cos bangle))))))
  159.          ((= quad 3) (Setq
  160.             fe   (polar fc (- bangle halfpi) fr)
  161.            fc2  (polar fc (- halfpi) (* fr (/ 2.0 (cos bangle))))))
  162.     );...End cond
  163.    (while (null (setq langle (getangle (polar fc2 (angle fc fc2) fr)
  164.     "\nDirection: "))))
  165.    (setq p0 (polar fc2
  166.        (if ccw (- langle halfpi)
  167.                (+ langle halfpi)) fr))
  168. (command "arc" "" fe "line" "" ls "" "arc" "" p0))))
  169.  
  170. ;------------------------------------ DRAW THE ARROWHEAD
  171. (IF (>= len (* 2 asiz))
  172.  (IF ccw
  173.     (command "pline" tp "w" (/ asiz 3.0) 0 "arc" "r" rad p1 "")
  174.     (command "pline" p1 "w" 0 (/ asiz 3.0) "arc" "r" rad tp "w" 0 0 "")))
  175.  
  176. ;----------------------------------- ADD LEADER TEXT
  177. (prompt "\nText: ")
  178. (if (<= 1 (quadrant langle0) 2)
  179. ;--------------------------- LEADER TO LEFT OF START
  180.   (command "dtext" (dxy start tsiz (* -0.5 tsiz)) tsiz 0)
  181.   (command "dtext" "right" (dxy start (- tsiz)(* -0.5 tsiz)) tsiz 0))
  182. (setvar "blipmode" bm)
  183. (setvar "orthomode" om)
  184. (princ)
  185. )
  186. ;-----------------------------------MESSAGE WHEN LOADED
  187. (princ "\nArcldr.LSP")
  188. (princ "\n(C) 1987 by Looking Glass Microproducts")
  189. (PRINC "\nTyped and debugged 5-1-88 by William S. Brock")
  190. (PRIN1)
  191. rror* (s)(princ (strcat "\n" s))
  192. (setvar "blipmode" bm)
  193. (princ))
  194. ;-------------------------------